home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MATH.SWG / 0031_Pythagorean Triples.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  6KB  |  185 lines
  1. Program PYTHAGOREAN_TRIPLES;
  2. {written by Mark Lewis, April 1, 1990}
  3. {developed and written in Turbo Pascal v3.0}
  4.  
  5. Const
  6.   hicnt     = 100;
  7.   ZERO      = 0;
  8.  
  9. Type
  10.   PythagPtr = ^PythagRec;           {Pointer to find the Record}
  11.   PythagRec = Record                {the Record we are storing}
  12.     A : Real;
  13.     B : Real;
  14.     C : Real;
  15.     total : Real;
  16.     next : PythagPtr    {Pointer to next Record in line}
  17.   end;
  18.  
  19. Var
  20.   Root      : PythagPtr;            {the starting point}
  21.   QUIT      : Boolean;
  22.   ch        : Char;
  23.  
  24. Procedure listdispose(Var root : pythagptr);
  25.  
  26. Var
  27.   holder : pythagptr;
  28.  
  29. begin
  30.   if root <> nil then               {if we have Records in the list}
  31.   Repeat                          {...}
  32.     holder := root^.next;         {save location of next Record}
  33.     dispose(root);                {remove this Record}
  34.     root := holder;               {go to next Record}
  35.   Until root = nil;               {Until they are all gone}
  36. end;
  37.  
  38. Procedure findpythag(Var root : pythagptr);
  39. Var
  40.   x,y,z,stored : Integer;
  41.   xy,zz,xx,yy  : Real;
  42.   abandon      : Boolean;
  43.   workrec      : pythagrec;
  44.   last,current : pythagptr;
  45.  
  46. begin
  47.   stored := zero;                   {init count at ZERO}
  48.   For z := 1 to hicnt do            {start loop 3}
  49.   begin
  50.     zz := sqr(z);                 {square loop counter}
  51.     if zz < zero then
  52.       zz := 65536.0 + zz;  {twiddle For negatives}
  53.     For y := 1 to hicnt do        {start loop 2}
  54.     begin
  55.       yy := sqr(y);             {square loop counter}
  56.       if yy < zero then
  57.         yy := 65536.0 + yy;  {twiddle For negatives}
  58.       For x := 1 to hicnt do    {start loop 1}
  59.       begin
  60.         abandon := False;     {keep this one}
  61.         xx := sqr(x);         {square loop counter}
  62.         xy := xx + yy;        {add sqr(loop2) and sqr(loop1)}
  63.         if not ((xy <> zz) or ((xy = zz) and (xy = 1.0))) then
  64.         begin
  65.           With workrec do
  66.           begin
  67.             a := x;       {put them into our storage Record}
  68.             b := y;
  69.             c := z;
  70.             total := zz;
  71.           end;
  72.           if root = nil then  {is this the first Record?}
  73.           begin
  74.             new(root);               {allocate space}
  75.             workrec.next := nil;     {anchor the Record}
  76.             root^ := workrec;        {store it}
  77.             stored := succ(stored);  {how many found?}
  78.           end
  79.           else                {this is not the first Record}
  80.           begin
  81.             current := root;  {save where we are now}
  82.             Repeat            {walk Records looking For dups}
  83.               if (current^.total = workrec.total) then
  84.                 abandon := True; {is this one a dup?}{abandon it}
  85.               last := current;  {save where we are}
  86.               current := current^.next  {go to next Record}
  87.             Until (current = nil) or abandon;
  88.             if not abandon then {save this one?}
  89.             begin
  90.               {we're going to INSERT this Record into the}
  91.               {line between the ones greater than and less}
  92.               {than the A Var in the Record}
  93.               {ie: 5,12,13 goes between 3,4,5 and 6,8,10}
  94.               if root^.a > workrec.a then
  95.               begin
  96.                 new(root);   {allocate mem For this one}
  97.                 workrec.next := last; {point to next rec}
  98.                 root^ := workrec;     {save this one}
  99.                 stored := succ(stored); {how many found?}
  100.               end
  101.               else  {insert between last^.next and current}
  102.               begin
  103.                 new(last^.next);  {allocate memory}
  104.                 workrec.next := current; {point to current}
  105.                 last^.next^ := workrec; {save this one}
  106.                 stored := succ(stored); {how many found?}
  107.               end;
  108.             end;
  109.           end;
  110.         end;
  111.       end;
  112.     end;
  113.   end;
  114.   Writeln('I have found and stored ',stored,' Pythagorean Triples.');
  115. end;
  116.  
  117. Procedure showRecord(workrec : pythagrec);
  118.  
  119. begin
  120.   With workrec do
  121.   begin
  122.     Writeln('A = ',a:6:0,'  ',sqr(a):6:0);
  123.     Writeln('B = ',b:6:0,'  ',sqr(b):6:0,'  ',sqr(a)+sqr(b):6:0);
  124.     Writeln('C = ',c:6:0,'  ',sqr(c):6:0,' <-^');
  125.   end
  126. end;
  127.  
  128. Procedure viewlist(root  : pythagptr);
  129.  
  130. Var
  131.   i        : Integer;
  132.   current  : pythagptr;
  133.  
  134. begin
  135.   if root = nil then
  136.   begin
  137.     Writeln('<< Your list is empty! >>');
  138.     Write('>> Press (CR) to continue: ');
  139.     readln;
  140.   end
  141.   else
  142.   begin
  143.     Writeln('Viewing Records');
  144.     current := root;
  145.     While current <> nil do
  146.     begin
  147.       showRecord(current^);
  148.       Write('Press (CR) to view next Record. . . ');
  149.       readln;
  150.       current := current^.next
  151.     end;
  152.   end
  153. end;
  154.  
  155. begin
  156.   Writeln('PYTHAGOREAN TRIPLES');
  157.   Writeln('-------------------');
  158.   Writeln;
  159.   Writeln('Remember the formula For a Right Triangle?');
  160.   Writeln('A squared + B squared = C squared');
  161.   Writeln;
  162.   Writeln('I call the set of numbers that fits this formula');
  163.   Writeln('         Pythagorean Triples');
  164.   Writeln;
  165.   Writeln('This Program Uses a "brute force" method of finding all');
  166.   Writeln('the Pythagorean Triples between 1 and 100');
  167.   Writeln;
  168.   root := nil;
  169.   quit := False;
  170.   Repeat
  171.     Writeln('Command -> [F]ind, [V]iew, [D]ispose, [Q]uit ');
  172.     readln(ch);
  173.     Case ch of
  174.       'q','Q' : quit := True;
  175.       'f','F' : findpythag(root);
  176.       'v','V' : viewlist(root);
  177.       'd','D' : listdispose(root);
  178.     end;
  179.   Until quit;
  180.   if root <> nil then
  181.     listdispose(root);
  182.   Writeln('Normal Program Termination');
  183. end.
  184.  
  185.